Visual Basic Graphics Programming (2nd Edition)/Visual Basic Graphics Programming 2nd Edition.iso/OldSrc/CH8/SRC/PICKOVER.FRM

Visual Basic Form | 1996-12-30 | 10.4 KB | 377 lines

VERSION 4.00
Begin VB.Form PickoverForm
   Caption         =   "Pickover"
   ClientHeight    =   5430
   ClientLeft      =   1800
   ClientTop       =   990
   ClientWidth     =   6375
   Height          =   6120
   Left            =   1740
   LinkTopic       =   "Form1"
   ScaleHeight     =   362
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   425
   Top             =   360
   Width           =   6495
   Begin VB.Frame Frame1
      Caption         =   "Projection"
      Height          =   1095
      Left            =   0
      TabIndex        =   19
      Top             =   3120
      Width           =   930
      Begin VB.OptionButton AxesChoice
         Caption         =   "YZ"
         Height          =   255
         Index           =   2
         Left            =   120
         TabIndex        =   22
         Top             =   720
         Width           =   615
      End
      Begin VB.OptionButton AxesChoice
         Caption         =   "XZ"
         Height          =   255
         Index           =   1
         Left            =   120
         TabIndex        =   21
         Top             =   480
         Width           =   615
      End
      Begin VB.OptionButton AxesChoice
         Caption         =   "XY"
         Height          =   255
         Index           =   0
         Left            =   120
         TabIndex        =   20
         Top             =   240
         Value           =   -1  'True
         Width           =   615
      End
   End
   Begin VB.TextBox Z0Text
      Height          =   285
      Left            =   240
      TabIndex        =   18
      Text            =   "0"
      Top             =   2640
      Width           =   615
   End
   Begin VB.TextBox Y0Text
      Height          =   285
      Left            =   240
      TabIndex        =   16
      Text            =   "0"
      Top             =   2280
      Width           =   615
   End
   Begin VB.TextBox X0Text
      Height          =   285
      Left            =   240
      TabIndex        =   14
      Text            =   "0"
      Top             =   1920
      Width           =   615
   End
   Begin VB.TextBox EText
      Height          =   285
      Left            =   240
      TabIndex        =   12
      Text            =   "1.0"
      Top             =   1440
      Width           =   615
   End
   Begin VB.TextBox DText
      Height          =   285
      Left            =   240
      TabIndex        =   10
      Text            =   "-2.5"
      Top             =   1080
      Width           =   615
   End
   Begin VB.TextBox CText
      Height          =   285
      Left            =   240
      TabIndex        =   8
      Text            =   "-0.6"
      Top             =   720
      Width           =   615
   End
   Begin VB.TextBox BText
      Height          =   285
      Left            =   240
      TabIndex        =   6
      Text            =   "0.5"
      Top             =   360
      Width           =   615
   End
   Begin VB.TextBox AText
      Height          =   285
      Left            =   240
      TabIndex        =   4
      Text            =   "2.0"
      Top             =   0
      Width           =   615
   End
   Begin VB.CommandButton CmdClear
      Caption         =   "Clear"
      Default         =   -1  'True
      Height          =   495
      Left            =   120
      TabIndex        =   2
      Top             =   4920
      Width           =   735
   End
   Begin VB.PictureBox Canvas
      AutoRedraw      =   -1  'True
      BackColor       =   &H00000000&
      FillStyle       =   0  'Solid
      ForeColor       =   &H000000FF&
      Height          =   5415
      Left            =   960
      ScaleHeight     =   357
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   357
      TabIndex        =   1
      Top             =   0
      Width           =   5415
   End
   Begin VB.CommandButton CmdGo
      Caption         =   "Go"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   4320
      Width           =   735
   End
   Begin VB.Label Label1
      Caption         =   "Z0"
      Height          =   255
      Index           =   7
      Left            =   0
      TabIndex        =   17
      Top             =   2640
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "Y0"
      Height          =   255
      Index           =   6
      Left            =   0
      TabIndex        =   15
      Top             =   2280
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "X0"
      Height          =   255
      Index           =   5
      Left            =   0
      TabIndex        =   13
      Top             =   1920
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "E"
      Height          =   255
      Index           =   4
      Left            =   0
      TabIndex        =   11
      Top             =   1440
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "D"
      Height          =   255
      Index           =   3
      Left            =   0
      TabIndex        =   9
      Top             =   1080
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "C"
      Height          =   255
      Index           =   2
      Left            =   0
      TabIndex        =   7
      Top             =   720
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "B"
      Height          =   255
      Index           =   1
      Left            =   0
      TabIndex        =   5
      Top             =   360
      Width           =   255
   End
   Begin VB.Label Label1
      Caption         =   "A"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   255
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuFileExit
         Caption         =   "E&xit"
      End
   End
Attribute VB_Name = "PickoverForm"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Const AXES_XY = 0
Const AXES_XZ = 1
Const AXES_YZ = 2
Dim Running As Boolean
Dim Axes As Integer
Dim A As Single
Dim B As Single
Dim C As Single
Dim D As Single
Dim E As Single
Dim X0 As Single
Dim Y0 As Single
Dim Z0 As Single
' ************************************************
' Draw the curve.
' ************************************************
Sub DrawCurve()
Const XMIN = -2.1
Const XMAX = 2.1
Const YMIN = -2.1
Const YMAX = 2.1
Const ZMIN = -1.2
Const ZMAX = 1.2
Dim wid As Single
Dim hgt As Single
Dim xoff As Single
Dim yoff As Single
Dim zoff As Single
Dim xscale As Single
Dim yscale As Single
Dim zscale As Single
Dim x As Single
Dim y As Single
Dim z As Single
Dim x2 As Single
Dim y2 As Single
Dim i As Integer
    ' See how much room we have.
    wid = Canvas.ScaleWidth
    hgt = Canvas.ScaleHeight
    Select Case Axes
        Case AXES_XY
            xoff = wid / 2
            yoff = hgt / 2
            xscale = wid / (XMAX - XMIN)
            yscale = hgt / (YMAX - YMIN)
        Case AXES_XZ
            xoff = wid / 2
            zoff = hgt / 2
            xscale = wid / (XMAX - XMIN)
            zscale = hgt / (ZMAX - ZMIN)
        Case AXES_YZ
            yoff = wid / 2
            zoff = hgt / 2
            yscale = wid / (YMAX - YMIN)
            zscale = hgt / (ZMAX - ZMIN)
    End Select
    ' Get the drawing parameters.
    GetParameters
    ' Compute the values.
    x = X0
    y = Y0
    z = Z0
    i = 0
    Do While Running
        ' Move to the next point.
        x2 = Sin(A * y) - z * Cos(B * x)
        y2 = z * Sin(C * x) - Cos(D * y)
        z = Sin(x)
        x = x2
        y = y2

        ' Plot the point.
        Select Case Axes
            Case AXES_XY
                Canvas.PSet (x * xscale + xoff, y * yscale + yoff), vbRed
            Case AXES_XZ
                Canvas.PSet (x * xscale + xoff, z * zscale + zoff), vbRed
            Case AXES_YZ
                Canvas.PSet (y * yscale + yoff, z * zscale + zoff), vbRed
        End Select

        ' To make things faster, only DoEvents
        ' every 100 times.
        i = i + 1
        If i > 100 Then
            i = 0
            DoEvents
        End If
    Loop
End Sub
' ************************************************
' Get the curve parameters.
' ************************************************
Sub GetParameters()
    If Not IsNumeric(AText.Text) Then AText.Text = "2"
    If Not IsNumeric(BText.Text) Then BText.Text = ".5"
    If Not IsNumeric(CText.Text) Then CText.Text = "-.6"
    If Not IsNumeric(DText.Text) Then DText.Text = "-2.5"
    If Not IsNumeric(EText.Text) Then EText.Text = "1"
    If Not IsNumeric(X0Text.Text) Then X0Text.Text = "0"
    If Not IsNumeric(Y0Text.Text) Then Y0Text.Text = "0"
    If Not IsNumeric(Z0Text.Text) Then Z0Text.Text = "0"
    A = CSng(AText.Text)
    B = CSng(BText.Text)
    C = CSng(CText.Text)
    D = CSng(DText.Text)
    E = CSng(EText.Text)
    X0 = CSng(X0Text.Text)
    Y0 = CSng(Y0Text.Text)
    Z0 = CSng(Z0Text.Text)
End Sub
' ************************************************
' Select the axes for projection.
' ************************************************
Private Sub AxesChoice_Click(Index As Integer)
    Axes = Index
End Sub
' ************************************************
' Erase the canvas.
' ************************************************
Private Sub CmdClear_Click()
    Canvas.Cls
End Sub
Private Sub CmdGo_Click()
Dim i As Integer
    If Running Then
        Running = False
        CmdGo.Enabled = False
        CmdGo.Caption = "Stopped"
    Else
        Running = True
        CmdGo.Caption = "Stop"
        DrawCurve
        CmdGo.Enabled = True
        CmdGo.Caption = "Go"
    End If
End Sub
Private Sub Form_Resize()
    Canvas.Move Canvas.Left, 0, _
        ScaleWidth - Canvas.Left, ScaleHeight - 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
    End
End Sub
Private Sub mnuFileExit_Click()
    Unload Me
End Sub